#!/usr/bin/perl

#**************************************************************************
#*                                                                        *
#*                                 OCaml                                  *
#*                                                                        *
#*             Xavier Leroy, projet Cristal, INRIA Rocquencourt           *
#*                                                                        *
#*   Copyright 2002 Institut National de Recherche en Informatique et     *
#*     en Automatique.                                                    *
#*                                                                        *
#*   All rights reserved.  This file is distributed under the terms of    *
#*   the GNU Lesser General Public License version 2.1, with the          *
#*   special exception on linking described in the file LICENSE.          *
#*                                                                        *
#**************************************************************************

foreach $f (@ARGV) {
    open(FILE, $f) || die("Cannot open $f");
    seek(FILE, -16, 2);
    $num_sections = &read_int();
    read(FILE, $magic, 12);
    seek(FILE, -16 - 8 * $num_sections, 2);
    @secname = ();
    @seclength = ();
    %length = ();
    for ($i = 0; $i < $num_sections; $i++) {
        read(FILE, $sec, 4);
        $secname[$i] = $sec;
        $seclength[$i] = &read_int();
        $length{$sec} = $seclength[$i];
    }
    print $f, ":\n" if ($#ARGV > 0);
    $path =
        $length{'RNTM'} > 0 ?
            &read_section('RNTM') :
            "(default runtime)\n";
    printf ("\tcode: %-7d data: %-7d symbols: %-7d debug: %-7d\n",
            $length{'CODE'}, $length{'DATA'},
            $length{'SYMB'}, $length{'DBUG'});
    printf ("\tmagic number: %s  runtime system: %s",
            $magic, $path);
    close(FILE);
}

sub read_int {
    read(FILE, $buff, 4) == 4 || die("Truncated bytecode file $f");
    @int = unpack("C4", $buff);
    return ($int[0] << 24) + ($int[1] << 16) + ($int[2] << 8) + $int[3];
}

sub read_section {
    local ($sec) = @_;
    local ($i, $ofs, $data);
    for ($i = $num_sections - 1; $i >= 0; $i--) {
        $ofs += $seclength[$i];
        if ($secname[$i] eq $sec) {
            seek(FILE, -16 - 8 * $num_sections - $ofs, 2);
            read(FILE, $data, $seclength[$i]);
            return $data;
        }
    }
    return '';
}
